In [1]:
suppressWarnings({
  suppressPackageStartupMessages({
    library(data.table)
    library(magrittr)
    library(data.table)
    library(dplyr)
    library(ggplot2)
    library(lubridate)
    library(vars)
    library(scales)
    library(forecast)
    library(tseries)
  })
})
In [2]:
options(repr.plot.width = 20, repr.plot.height = 20, repr.plot.res = 500)
In [3]:
# Duomenu uzkrovimas

url <- "http://web.vu.lt/mif/a.buteikis/wp-content/uploads/2023/09/Macro_2023_SVAR.R"
source(url, encoding = "UTF-8")
DT_0 <- get_data(2012527)
df <- as.data.frame(DT_0)
[1] "Country: Italy"
[1] "Surastas failas 'duomenys_atsiskaitymas_2.RDS'. Užkraunami duomenys iš direktorijos..."

I dalis: Duomenų paruošimas¶

1. Prieš pradedant analizuoti duomenis - detaliau susipažinkite su minėtu straipsniu ir aprašykite:

a. Į kokį klausimą bandoma atsakyti (t. y., kodėl atliekamas ekonometrinis modeliavimas)?

Skaičiuojamos fiskalinių daugiklių reikšmės tam tikriems makroekonominiams rodikliams tam, kad suprasti (išsiaiškinti) kaip šios reikšmės gali kisti priklausomai nuo valstybės skolos (angl. public debt), ekonomikos augimo greičio (angl. pace of economic growth) bei skirtumo tarp esamo bei potencialaus BVP (angl. output gap).

Ekonometrinis modeliavimas (konkrečiai, SVAR) yra atliekamas dėl to, jog fiskalinių rodiklių reikšmės yra kintančios. Pastarosios kinta dėl įvairių priežasčių kur viena iš jų galėtų būti egzogeniniai fiskaliniai šokai (kurie atsiranda dėl fiskalinės politikos pokyčių, ekonominių krizių ir kt.).

Taip pat, viena iš esminių SVAR savybių yra ta, jog šis modelis gali įvertinti kiekvieno iš kintamųjų atsaką tuo pačiu metu. SVAR gali padėti įvertinti sudėtingus ryšius tarp skirtingų kintamųjų tuo pačiu metu.

Ekonometrinio modeliavimo tikslas yra įvertinti fiskalinių (makroekomominių rodiklių) daugiklių reikšmes, atsirandančias dėl vyriausybės išlaidų bei mokestinių pajamų fiskalinio šoko.

b. Kokie straipsniuose naudojami duomenys VAR modeliavimui - kokie kintamieji, kokio dažnumo, koks laikotarpis, kokios šalies(-ių) duomenys, kokie analizuojamų rodiklių matavimo vienetai? Jeigu kai kurie rodikliai matuojami valiuta - ar tai realios, ar nominalios kainos?

Duomenys: Eurozonos šalių makroekonominiai rodikliai nuo EMU (European Monetary Union) sukūrimo. Laikotarpis nuo 2000 m. iki 2016 m. (ketvirtiniai duomenys).

Kintamieji:

GDP (liet. BVP)
Primary Expenditure (liet. valstybės išlaidos)
Income and Wealth Taxes (liet. valstybės pajamos iš mokesčių, taikomų pajamoms ir turtui)
Production and Imports Taxes (liet. valstybės pajamos iš mokesčių, taikomų produkcijai ir importui) \ Debt (liet. valstybės skola)

Visi kintamiej (išskyrus GDP) yra pateikiami realiomis kainomis (Eur), vienam gyventojui (angl. per capita). Taip pat, "Debt" yra % nuo "GDP".

c. Ar laiko eilučių duomenys kaip nors transformuojami (pvz. pašalinamas sezoniškumas, logaritmuojama, imami skirtumai, skaičiuojama vienam gyventojui tenkanti rodiklio dalis ar pan.) ar laiko eilutės stacionarios?

Taip, laiko eiličių duomenys yra transformuojami. Straipsnyje minima, jog visi rodikliai (apart GDP) yra paskaičiuoti vienam gyvenotojui bei logaritmuoti. Taip pat visi kintamieji (įskaitant GDP) yra paimti su skirtumais vienetinės šaknies testo atžvilgiu.

d. Kam naudojamas valstybės skolos nuo BVP dalies rodiklis?

Šis rodiklis yra naudojamas kaip pseudo kintamasis (angl. dummmy variable) dideliam valstybės skolos lygiui su 60 % slenksčiu (angl. threshold). Nustatytas slenkstis atskiria šalis, kur sumos yra žemiau arba virš šios reikšmės.

2. Iš turimų duomenų atsirinkite ir pasiruoškite reikalingus:

a. Išbrėžkite pradinių duomenų laiko eilučių grafikus. Kokias tendencijas pastebite? Ar pastebite kokių nors struktūrinių pasikeitimų?

In [4]:
DT_0 %>% filter(na_item != "Gross domestic product at market prices") %>%
  ggplot(aes(x = time, y = values)) +
  geom_line(aes(group = na_item, color = na_item), linewidth = 0.5) +
  facet_wrap(~ na_item, scales = "free", nrow = 5) +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  theme_bw() +
  theme(legend.position = "none")
No description has been provided for this image

[1] "General government: Current taxes on income, wealth, etc., receivable": valstybės pajamos iš mokesčių, taikomų pajamoms ir turtui (mln. Eur). Grafike gana aiškiai matomas vyraujantis sezoniškumas. Tai yra normalu, kadangi šio rodiklio duomenyse nėra pašalintas sezoniškumas. Taip pat, pastebima augimo tendencija, kadangi grafiko kreivė yra kylanti.

[2] "General government: Government consolidated gross debt": valstybės skola (% nuo BVP). Rodiklio duomenyse nėra pašalintas sezoniškumas, tačiau grafike to nematyti. Kaip ir prieš tai buvusiu atveju, matoma augimo tendencija. Tiesa ji yra kur kas aiškesnė, kadangi panašu, jog kreivė nėra įtakota sezoniškumo. Matomas pastovus skolos augimas. Maždaug nuo 2009 m. iki ~ 2012 m. skolos lygis kito itin mažai ir išliko lygiagretus X ašiai. Vėliau nuo maždaug 2013 m. matomas gana drastiškas augimas, kuris tęsėsi iki 2015 m. Nuo 2015 m. iki 2020 m. skolos lygis išliko maždaug vienodas, su nedideliais svyravimais aukštyn/žemyn. Pastebima, jog nuo 2020 m. prasidėjus COVID19 pandemijai, skolos lygis smarkiai ir drastiškai išaugo. Galiausiai, apie 2022 m. nukrito lygiai taip pat greitai kaip ir buvo pakilęs.

[3] "General government: Taxes on production and imports, receivable": valstybės pajamos iš mokesčių, taikomų produkcijai ir importui (mln. Eur). Kadangi rodiklio duomenyse nėra pašalintas sezoniškumas tai lygiai kaip ir pirmojo rodiklio atžvilgiu, itin matomas vyraujantis sezoniškumas. Grafike galima įžvelgti augimo tendenciją, kadangi grafiko kreivė yra kylanti.

[4] "General government: Total general government expenditure": valstybės išlaidos (mln. Eur). Rodiklio duomenyse nėra pašalintas sezoniškumas, tad grafike įžvelgiama sezoniškumo. Grafike taip pat matoma augimo tendencija ir ji buvo ryškiausia maždaug nuo 2020 m. Vėlgi, tai yra normalu, kadangi būtent tuo metu prasidėjo COVID19 pandemija ir valstybės išlaidos išaugo.

[5] "Total Population (Total), 15 years or over": populiacija >= 15 metų (tūkst.). Duomenyse nėra pašalintas sezoniškumas, tačiau kitu atveju, tai yra tiesiog populiacijos dydis šalyje. Pastebima stipri augimo tendencija nuo 2005 m. iki 2015 m. Nuo 2015 m. iki 2020 m. populiacijos lygis išliko maždaug vienodas. Nuo 2020 m. pastebima populiacijos mažėjimo tendencija, kuri yra gana drastiška.

In [5]:
# GDP grafikai

DT_0 %>% filter(na_item == "Gross domestic product at market prices") %>%
  ggplot(aes(x = time, y = values)) +
  geom_line(aes(color = interaction(s_adj, unit)), linewidth = 0.5) + labs(title = "Gross domestic product at market prices") +
  facet_wrap(s_adj ~ unit, scales = "free") +
  theme_bw() +
  theme(legend.position = "none")
No description has been provided for this image

Seasonally and calendar adjusted data:

Kadangi duomenyse pašalintas sezoniškumas, tai grafikai yra konkretesni. Labiau pastebimos tendencijos ir turimas aiškesnis vaizdas apie rodiklio kitimą.

[1] "Chain linked volumes (2015), million euro": BVP realiomis kainomis. Grafike sunku įžvelgti vien tik augimo ar kritimo tendenciją, tačiau tai vis tik labiau atspindi kritimą. Didžiausias šokas buvo patirtas 2020 m., kai rodiklio reikšmė nuo 425 tūkst. krito žemiau nei 375 tūkst.
[2] "Current prices, million euro": BVP nominaliomis kainomis. Bendrai grafike yra matoma augimo tendencija, tačiau kaip ir kitų rodiklių grafikuose, taip ir čia matomas gan stiprus kritimas, įvykęs 2020 m. Po jo vėl matoma augimo tendencija, kuri buvo gan sparti.
[3] "Price index (implicit deflator), 2015=100, euro": BVP defliatorius. Matoma vientisa augimo tendencija be didesnių sukrėtimų/šokų, kurie neigiamai paveiktų augimą.

Unadjusted data:

Šiuo atveju matome tuos pačius grafikus, kurie iš esmės atspindi tas pačias tendencijas kaip ir praeiti. Kadangi duomenyse nėra pašalintas sezoniškumas, tai jis grafikuose pastebimas gana stipriai.

b. Pasinaudokite [eurostat metodika] ir įsitikinkite, kad duomenyse santykis tarp nominalaus ir realaus BVP atitinka BVP defliatoriaus rodiklį.

In [6]:
### GDP (current prices & chain-linked volumes)

# Seasonally adjusted
    
GDP_nominal_adj <- sum(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" &
                   DT_0$unit == "Chain linked volumes (2015), million euro" &
                   DT_0$s_adj == "Seasonally and calendar adjusted data"])

GDP_real_adj <- sum(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" &
                                   DT_0$unit == "Current prices, million euro" &
                                   DT_0$s_adj == "Seasonally and calendar adjusted data"])

GDP_deflator_adj <- (GDP_nominal_adj / GDP_real_adj) * 100

GDP_deflator_reported_adj <- mean(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" & 
                                                DT_0$unit == "Price index (implicit deflator), 2015=100, euro" & 
                                                DT_0$s_adj == "Seasonally and calendar adjusted data"], 
                                  na.rm = TRUE)

GDP_deflator_adj / GDP_deflator_reported_adj

# Duomenyse santykis tarp nominalaus ir realaus BVP beveik atitinka BVP defliatoriaus rodiklį (apskaičiuotas BVP defliatorius
# yra šiek tiek didesnis nei tas, kuris pateiktas duomenyse)

# Seasonally unadjusted
    
GDP_nominal_unadj <- sum(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" &
                                      DT_0$unit == "Chain linked volumes (2015), million euro" &
                                      DT_0$s_adj == "Unadjusted data (i.e. neither seasonally adjusted nor calendar adjusted data)"])

GDP_real_unadj <- sum(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" &
                                   DT_0$unit == "Current prices, million euro" &
                                   DT_0$s_adj == "Unadjusted data (i.e. neither seasonally adjusted nor calendar adjusted data)"])

GDP_deflator_unadj <- (GDP_nominal_unadj / GDP_real_unadj) * 100

GDP_deflator_reported_unadj <- mean(DT_0$values[DT_0$na_item == "Gross domestic product at market prices" & 
                                                DT_0$unit == "Price index (implicit deflator), 2015=100, euro" & 
                                                DT_0$s_adj == "Unadjusted data (i.e. neither seasonally adjusted nor calendar adjusted data)"], 
                                  na.rm = TRUE)

GDP_deflator_unadj / GDP_deflator_reported_unadj

# Duomenyse santykis tarp nominalaus ir realaus BVP beveik atitinka BVP defliatoriaus rodiklį (apskaičiuotas BVP defliatorius
# yra šiek tiek didesnis nei tas, kuris pateiktas duomenyse).
1.03984760701418
1.04023751823835

c. Apskaičiuokite reikalingų rodiklių reikšmes realiomis kainomis (žr. [Wiki 1], [Wiki 2] ir [“Inflation adjustment”]);

In [7]:
# Modeliavimui naudojami kintamieji: 

# "General government: Taxes on production and imports, receivable"
# "General government: Current taxes on income, wealth, etc., receivable"
# "General government: Total general government expenditure"
# "General government: Government consolidated gross debt"
# "Gross domestic product at market prices"

df <- subset(df, 
             na_item != "Total Population (Total), 15 years or over" & 
               !(na_item == "Gross domestic product at market prices" & 
                   s_adj == "Unadjusted data (i.e. neither seasonally adjusted nor calendar adjusted data)") & 
               unit != "Chain linked volumes (2015), million euro" & 
               unit != "Price index (implicit deflator), 2015=100, euro",
             select = -geo)

taxes_prod_imp <- data.frame(taxes_pr_imp = df$values[df$na_item == "General government: Taxes on production and imports, receivable"])
taxes_wealth <- data.frame(taxes_w = df$values[df$na_item == "General government: Current taxes on income, wealth, etc., receivable"])
gov_exp <- data.frame(exp = df$values[df$na_item == "General government: Total general government expenditure"])
gov_debt <- df$values[df$na_item == "General government: Government consolidated gross debt"] # % from GDP
gdp <- data.frame(gdp = df$values[df$na_item == "Gross domestic product at market prices"]) # current prices
gdp_def <- DT_0$values[DT_0$na_item == "Gross domestic product at market prices" & 
                         DT_0$unit == "Price index (implicit deflator), 2015=100, euro" &
                         DT_0$s_adj == "Seasonally and calendar adjusted data"]

taxes_prod_imp$time <- DT_0$time[DT_0$na_item == "General government: Taxes on production and imports, receivable"]
taxes_wealth$time <- DT_0$time[DT_0$na_item == "General government: Current taxes on income, wealth, etc., receivable"]
gov_exp$time <- DT_0$time[DT_0$na_item == "General government: Total general government expenditure"]



df2 <- data.frame(taxes_prod_imp = taxes_prod_imp, taxes_wealth = taxes_wealth, gov_exp = gov_exp,
                  gov_debt = gov_debt, gdp = gdp, gdp_def = gdp_def)

# Inflation adjustment
    
taxes_prod_imp$inf_adj <- (taxes_prod_imp$taxes_pr_imp / df2$gdp_def) * 100
taxes_wealth$inf_adj <- (taxes_wealth$taxes_w / df2$gdp_def) * 100
gov_exp$inf_adj <- (gov_exp$exp / df2$gdp_def) * 100
gdp$inf_adj <- (df2$gdp / df2$gdp_def) * 100

d. Jeigu reikia - pritaikykite kitas transformacijas, tokias kaip vienam gyventojui tenkanti rodiklio dalis, logaritmavimas, sezoniškumo šalinimas ir pan.

In [8]:
options(repr.plot.width = 15, repr.plot.height = 5, repr.plot.res = 500)
In [9]:
# Per capita adjustment
    
taxes_prod_imp$per_capita <- taxes_prod_imp$inf_adj / DT_0$values[DT_0$na_item == "Total Population (Total), 15 years or over"]
taxes_wealth$per_capita <- taxes_wealth$inf_adj / DT_0$values[DT_0$na_item == "Total Population (Total), 15 years or over"]
gov_exp$per_capita <- gov_exp$inf_adj / DT_0$values[DT_0$na_item == "Total Population (Total), 15 years or over"]
gdp$per_capita <- gdp$inf_adj / DT_0$values[DT_0$na_item == "Total Population (Total), 15 years or over"]

# Seasonality adjustment: 'taxes_prod_imp', 'taxes_wealth', 'gov_exp'

df_ts <- ts(taxes_prod_imp$per_capita, frequency = 4, start = c(year(min(taxes_prod_imp$time)), quarter(min(taxes_prod_imp$time))))
plot(df_ts, main = "Seasonally unadjusted TS, Taxes on Production & Import")
decomp <- stl(df_ts, s.window = "periodic")
taxes_prod_imp$sa_adj <- c(seasadj(decomp))

df_ts_adj_sa <- ts(taxes_prod_imp$sa_adj, frequency = 4, start = c(year(min(taxes_prod_imp$time)), quarter(min(taxes_prod_imp$time))))
plot(df_ts_adj_sa, main = "Seasonally adjusted TS, Taxes on Production & Import")

#####
    
df_ts <- ts(taxes_wealth$per_capita, frequency = 4, start = c(year(min(taxes_wealth$time)), quarter(min(taxes_wealth$time))))
plot(df_ts, main = "Seasonally unadjusted TS, Taxes on Income, Wealth, etc.")
decomp <- stl(df_ts, s.window = "periodic")
taxes_wealth$sa_adj <- c(seasadj(decomp))

df_ts_adj_sa <- ts(taxes_wealth$sa_adj, frequency = 4, start = c(year(min(taxes_wealth$time)), quarter(min(taxes_wealth$time))))
plot(df_ts_adj_sa, main = "Seasonally adjusted TS, Taxes on Income, Wealth, etc.")

#####

df_ts <- ts(gov_exp$per_capita, frequency = 4, start = c(year(min(gov_exp$time)), quarter(min(gov_exp$time))))
plot(df_ts, main = "Seasonally unadjusted TS, Government Expenditure")
decomp <- stl(df_ts, s.window = "periodic")
gov_exp$sa_adj <- c(seasadj(decomp))

df_ts_adj_sa <- ts(gov_exp$sa_adj, frequency = 4, start = c(year(min(gov_exp$time)), quarter(min(gov_exp$time))))
plot(df_ts_adj_sa, main = "Seasonally adjusted TS, Government Expenditure")
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image

e. Ar nagrinėjami rodikliai turi vienetinę šaknį? Užrašykite nulinę hipotezę, aprašykite pasirinkto testo esmę (pvz. ADF testo) ir patikrinkite šią hipotezę kiekvienam rodikliui. Jeigu rodikliai turi vienetines šaknis - pritaikykite atitinkamas transformacijas į tai atsižvelgti.

In [10]:
# Testui naudojamas Augmented Dickey-Fuller (ADF) testas, kuris kiek pranašesnis nei įprastas DF testas tuo, jog naudoja 
# 'lagged' laiko eil. skirtumus. Tai padeda užtikrinti, jog atsitiktinės paklaidos nėra koreliuotos (angl. serially corellated). 
# Taip pat ADF testas yra lankstesnis, kadangi 'lagged' skirtumų įtraukimas leidžia turėti aukštesnės eilės serijinę koreliaciją.
# Taigi, ADF yra tinkamas įvairesniems duomenims nei, kad įprastas DF.
    
# H0: vienetinė šaknis egzistuoja
# H1: vienetinė šaknis neegzistuoja
    
adf.test(taxes_prod_imp$sa_adj, alternative = "stationary")
adf.test(taxes_wealth$sa_adj, alternative = "stationary")
adf.test(gov_exp$sa_adj, alternative = "stationary")
adf.test(gdp$per_capita, alternative = "stationary")

# taxes_prod_imp: p-value < 0.05 -> H0 atmetamas
# taxes_wealth: p-value > 0.05 -> H0 neatmetamas, vienetinė šaknis egzistuoja
# gov_exp: p-value > 0.05 -> H0 neatmetamas, vienetinė šaknis egzistuoja
# gdp: p-value > 0.05 -> H0 neatmetamas, vienetinė šaknis egzistuoja
    
# Kadangi kintamiesiems 'taxes_wealth', 'gov_exp' bei 'gdp' p-value buvo didesnė nei 0.05, tai reiškia, jog vienetinė šaknis
# egzistuoja. Kitaip tariant, šie laiko eil. duomenys nėra stacionarūs. Kintamiesiems bus atliekamos transformacijos ir tikrinama
# ar stacionarumas atsirado.
    
adf.test(diff(taxes_wealth$sa_adj), alternative = "stationary")

# Vieną kartą pritaikius 'lagged differences' funkciją rezultatas išliko nepakitęs ir duomenys toliau yra stacionarūs.
    
adf.test(diff(taxes_wealth$sa_adj, differences = 2), alternative = "stationary")

# Pritaikius diferencijavimą du kartus, atsirado stacionarumas. Teigiama, jog 'taxes_wealth' yra stac. laiko eil.
    
adf.test(diff(gov_exp$sa_adj), alternative = "stationary")

# Ta pati situacija kaip ir prieš tai, p-value > 0.05. Duomenys vis dar nestacionarūs.
    
adf.test(diff(gov_exp$sa_adj, differences = 2), alternative = "stationary")

# Atlikus papildomą transformaciją, p-value < 0.05. Teigiama, jog 'gov_exp' yra stac. laiko eil.
    
adf.test(diff(gdp$per_capita), alternative = "stationary")

# 'gdp' atveju užteko vieną kartą pritaikyti 'lagged differences' f-ją. Teigiama, jog 'gdp' yra stac. laiko eil.
Warning message in adf.test(taxes_prod_imp$sa_adj, alternative = "stationary"):
"p-value smaller than printed p-value"
	Augmented Dickey-Fuller Test

data:  taxes_prod_imp$sa_adj
Dickey-Fuller = -4.5454, Lag order = 4, p-value = 0.01
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  taxes_wealth$sa_adj
Dickey-Fuller = -2.9726, Lag order = 4, p-value = 0.1793
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  gov_exp$sa_adj
Dickey-Fuller = -3.4045, Lag order = 4, p-value = 0.06196
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  gdp$per_capita
Dickey-Fuller = -3.3584, Lag order = 4, p-value = 0.06935
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  diff(taxes_wealth$sa_adj)
Dickey-Fuller = -3.3567, Lag order = 4, p-value = 0.06975
alternative hypothesis: stationary
Warning message in adf.test(diff(taxes_wealth$sa_adj, differences = 2), alternative = "stationary"):
"p-value smaller than printed p-value"
	Augmented Dickey-Fuller Test

data:  diff(taxes_wealth$sa_adj, differences = 2)
Dickey-Fuller = -6.6211, Lag order = 4, p-value = 0.01
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  diff(gov_exp$sa_adj)
Dickey-Fuller = -2.9225, Lag order = 4, p-value = 0.1999
alternative hypothesis: stationary
Warning message in adf.test(diff(gov_exp$sa_adj, differences = 2), alternative = "stationary"):
"p-value smaller than printed p-value"
	Augmented Dickey-Fuller Test

data:  diff(gov_exp$sa_adj, differences = 2)
Dickey-Fuller = -7.3776, Lag order = 4, p-value = 0.01
alternative hypothesis: stationary
	Augmented Dickey-Fuller Test

data:  diff(gdp$per_capita)
Dickey-Fuller = -4.0099, Lag order = 4, p-value = 0.01431
alternative hypothesis: stationary

f. Galutinius atrinktus ir sutvarkytus rodiklius priskirkite atskiram kintamajam (kaip data.table, ar tibble tipo duomenų masyvą) ir išsibrėžkite tik galutinių atrinktų ir sutvarkytų rodiklių grafikus.

In [11]:
options(repr.plot.width = 20, repr.plot.height = 20, repr.plot.res = 500)
In [12]:
df_final <- data.frame(time = taxes_prod_imp$time, taxes_prod_imp = taxes_prod_imp$sa_adj, 
                       taxes_wealth = c(NA, NA, diff(taxes_wealth$sa_adj, differences = 2)),
                       gov_exp = c(NA, NA, diff(gov_exp$sa_adj, differences = 2)), 
                       gdp = c(NA, diff(gdp$per_capita)))

df_final_long <- melt(setDT(as.data.table(df_final)), measure.vars = 2:5, variable.name = "variable")

df_final_long %>%
  ggplot(aes(x = time, y = value)) +
  geom_line(aes(group = variable, color = variable), linewidth = 0.5) +
  facet_wrap(~ variable, scales = "free", nrow = 5) + # galima prideti nrow = 5; pabandyti pažiūrėti kitą kartą arba pridėti du grafikus: vienas su nrow ir kitas be
  theme_bw() +
  theme(legend.position = "none")
Warning message:
"Removed 5 rows containing missing values (`geom_line()`)."
No description has been provided for this image

Transformacijos, kurios buvo atliktos kintamiesiems:

  • taxes_prod_imp: inflation adjustment, seasonality adjustment, per capita adjustment;
  • taxes_wealth: inflation adjustment, seasonality adjustment, per capita adjustment, diferencijavimas (2x);
  • gov_exp: inflation adjustment, seasonality adjustment, per capita adjustment, diferencijavimas (2x);
  • gov_debt: -;
  • gdp: inflation adjustment, per capita adjustment, diferencijavimas.

Labiausiai pasisekusi kintamojo transformacija buvo "taxes_prod_imp". Iš grafiko pastebima, jog sezoniškumo praktiškai nėra. Kas liečia kintamuosius "taxes_wealth" bei "gov_exp", sezoniškumas tam tikrose vietose dar vyrauja, tačiau grafikai atrodo kur kas geriau nei tie, kurie buvo išbrėžti naudojant pradinius (neapdorotus) duomenis.

Kas liečia "gov_debt", tai šiam kintamajam jokios transformacijos nebuvo atliekamos, kadangi duomenys yra procentiniai. Kintamajam "gdp" buvo atliktos tik dvi transformacijos, tačiau tiek pirminis tiek galutinis grafikas iš esmės atrodo identiškai. Pagrindinė to priežastis yra tai, jog pradiniuose duomenyse buvo pateikta "seasonally and calendar adjusted" GDP versija.

II dalis: Adekvataus VAR modelio sudarymas¶

3. Pasirinkite VAR modelio eilę, pagrįskite šį pasirinkimą. Sudarykite ir įvertinkite VAR modelį.

In [13]:
df_final <- na.omit(df_final)
rownames(df_final) <- NULL

VARselect(df_final[, 2:5], lag.max = 12, type = "const")$selection # 'const' - įtraukia 'intercept' komponentę, bet ne 'trend' ar 'seasonal'
VARselect(df_final[, 2:5], lag.max = 4, type = "const")$selection

# Pasirenkama, jog didžiausias lag skaičius būtų 12. Visos metrikos siūlo skirtingus lag kiekius. Lag skaičiaus pasirinkimas nėra
# pagrįstas. Pasirinkta atsitiktinai.
# Įdomumo dėlei papildomai pasirinktas straipsnyje naudojamas lag skaičius - 4.
AIC(n)
12
HQ(n)
3
SC(n)
2
FPE(n)
6
AIC(n)
4
HQ(n)
2
SC(n)
2
FPE(n)
4
In [14]:
VAR_mdl.1 <- VAR(df_final[, 2:5], p = 12, type = "const")
VAR_mdl.2 <- VAR(df_final[, 2:5], p = 6, type = "const")
VAR_mdl.3 <- VAR(df_final[, 2:5], p = 4, type = "const")
VAR_mdl.4 <- VAR(df_final[, 2:5], p = 3, type = "const")
VAR_mdl.5 <- VAR(df_final[, 2:5], p = 2, type = "const")
In [15]:
lapply(summary(VAR_mdl.1)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 49 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.40160.2379 1.68830.1256
taxes_wealth.l1 -0.12950.2747-0.47150.6485
gov_exp.l1 -0.26980.1524-1.77050.1104
gdp.l1 0.24970.1559 1.60160.1437
taxes_prod_imp.l2 0.22030.2697 0.81690.4351
taxes_wealth.l2 -0.48810.5805-0.84090.4222
gov_exp.l2 -0.31230.2790-1.11920.2920
gdp.l2 -0.06320.2061-0.30650.7662
taxes_prod_imp.l3 -0.00360.3199-0.01140.9912
taxes_wealth.l3 -1.05760.8406-1.25810.2400
gov_exp.l3 -0.35830.3644-0.98310.3512
gdp.l3 -0.02360.1375-0.17190.8673
taxes_prod_imp.l4 0.18540.3344 0.55430.5929
taxes_wealth.l4 -1.08851.0156-1.07180.3117
gov_exp.l4 -0.34450.3998-0.86180.4112
gdp.l4 0.02130.0842 0.25270.8061
taxes_prod_imp.l5 -0.64200.3500-1.83460.0998
taxes_wealth.l5 -0.80751.0015-0.80630.4409
gov_exp.l5 -0.37300.4187-0.89100.3961
gdp.l5 -0.07950.0687-1.15750.2769
taxes_prod_imp.l6 -0.27670.3334-0.82990.4280
taxes_wealth.l6 -0.86910.8811-0.98650.3497
gov_exp.l6 -0.69200.4172-1.65880.1315
gdp.l6 0.08320.0683 1.21800.2542
taxes_prod_imp.l7 0.17050.3513 0.48540.6390
taxes_wealth.l7 -0.39520.7629-0.51800.6169
gov_exp.l7 -0.86500.4416-1.95870.0818
gdp.l7 0.02280.0680 0.33520.7452
taxes_prod_imp.l8 0.67700.3593 1.88420.0922
taxes_wealth.l8 -0.08130.6991-0.11630.9100
gov_exp.l8 -1.01500.4545-2.23290.0524
gdp.l8 -0.09950.0767-1.29700.2269
taxes_prod_imp.l9 -0.16800.3545-0.47390.6469
taxes_wealth.l9 -0.08570.6631-0.12930.9000
gov_exp.l9 -1.05650.4323-2.44380.0371
gdp.l9 -0.00180.0811-0.02270.9824
taxes_prod_imp.l10 0.18040.3248 0.55550.5921
taxes_wealth.l10 0.14250.5950 0.23950.8161
gov_exp.l10 -0.67490.3849-1.75340.1134
gdp.l10 -0.08830.0799-1.10480.2979
taxes_prod_imp.l11-0.18370.3414-0.53810.6036
taxes_wealth.l11 0.00810.4573 0.01770.9863
gov_exp.l11 -0.59990.3113-1.92700.0861
gdp.l11 -0.05130.0699-0.73420.4815
taxes_prod_imp.l12-0.86110.3375-2.55160.0311
taxes_wealth.l12 -0.15450.2361-0.65470.5291
gov_exp.l12 -0.42520.2016-2.10950.0641
gdp.l12 0.04040.0561 0.72040.4895
const 1.54220.5992 2.57370.0300
$taxes_wealth
A data.frame: 49 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 -0.01140.2478-0.04600.9643
taxes_wealth.l1 -1.66350.2862-5.81280.0003
gov_exp.l1 -0.08090.1587-0.50980.6224
gdp.l1 0.34050.1624 2.09670.0655
taxes_prod_imp.l2 -0.46840.2809-1.66750.1298
taxes_wealth.l2 -2.02440.6047-3.34790.0086
gov_exp.l2 0.22190.2906 0.76360.4646
gdp.l2 -0.54070.2147-2.51800.0329
taxes_prod_imp.l3 -0.29270.3332-0.87850.4025
taxes_wealth.l3 -2.37170.8756-2.70850.0241
gov_exp.l3 0.03690.3796 0.09730.9246
gdp.l3 0.30070.1432 2.10030.0651
taxes_prod_imp.l4 -0.46640.3484-1.33890.2134
taxes_wealth.l4 -1.81721.0579-1.71780.1200
gov_exp.l4 0.04850.4164 0.11640.9099
gdp.l4 0.02330.0878 0.26590.7963
taxes_prod_imp.l5 0.22100.3645 0.60620.5594
taxes_wealth.l5 -1.27371.0432-1.22090.2531
gov_exp.l5 -0.13880.4361-0.31830.7575
gdp.l5 0.00560.0716 0.07760.9399
taxes_prod_imp.l6 0.74110.3473 2.13370.0616
taxes_wealth.l6 -1.13240.9178-1.23390.2485
gov_exp.l6 -0.25920.4346-0.59650.5655
gdp.l6 -0.02240.0712-0.31540.7596
taxes_prod_imp.l7 0.18630.3659 0.50910.6229
taxes_wealth.l7 -0.68810.7947-0.86590.4091
gov_exp.l7 -0.28050.4600-0.60970.5572
gdp.l7 -0.09840.0708-1.39000.1980
taxes_prod_imp.l8 0.11140.3743 0.29780.7726
taxes_wealth.l8 -0.91600.7282-1.25790.2401
gov_exp.l8 -0.31400.4735-0.66320.5238
gdp.l8 -0.06590.0799-0.82490.4308
taxes_prod_imp.l9 -0.38630.3692-1.04620.3227
taxes_wealth.l9 -0.90840.6908-1.31510.2210
gov_exp.l9 -0.20960.4503-0.46530.6527
gdp.l9 -0.00200.0845-0.02340.9818
taxes_prod_imp.l10-0.31980.3383-0.94530.3692
taxes_wealth.l10 -0.61660.6198-0.99490.3458
gov_exp.l10 -0.04960.4009-0.12370.9043
gdp.l10 -0.03320.0832-0.39830.6997
taxes_prod_imp.l11-0.05970.3556-0.16800.8703
taxes_wealth.l11 -0.51170.4764-1.07400.3108
gov_exp.l11 -0.21830.3242-0.67340.5176
gdp.l11 0.01080.0728 0.14850.8852
taxes_prod_imp.l12-0.01450.3515-0.04130.9680
taxes_wealth.l12 -0.20110.2459-0.81790.4345
gov_exp.l12 -0.03300.2099-0.15730.8785
gdp.l12 -0.06150.0585-1.05260.3200
const 0.90170.6242 1.44460.1825
$gov_exp
A data.frame: 49 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 -0.56990.5501-1.03590.3273
taxes_wealth.l1 -0.17470.6353-0.27500.7895
gov_exp.l1 -1.54300.3524-4.37850.0018
gdp.l1 -0.21860.3606-0.60630.5593
taxes_prod_imp.l2 0.76480.6236 1.22640.2512
taxes_wealth.l2 0.03391.3425 0.02530.9804
gov_exp.l2 -1.73150.6453-2.68330.0251
gdp.l2 -0.15880.4767-0.33300.7468
taxes_prod_imp.l3 0.21910.7397 0.29620.7738
taxes_wealth.l3 0.48861.9441 0.25130.8072
gov_exp.l3 -1.42130.8428-1.68640.1260
gdp.l3 0.12060.3179 0.37950.7131
taxes_prod_imp.l4 -0.35690.7735-0.46140.6554
taxes_wealth.l4 1.28052.3487 0.54520.5989
gov_exp.l4 -1.05480.9245-1.14090.2834
gdp.l4 -0.05850.1948-0.30020.7709
taxes_prod_imp.l5 -0.11220.8093-0.13870.8928
taxes_wealth.l5 1.47912.3162 0.63860.5390
gov_exp.l5 -0.82180.9682-0.84870.4180
gdp.l5 0.16770.1589 1.05530.3188
taxes_prod_imp.l6 -0.14830.7711-0.19240.8517
taxes_wealth.l6 0.76682.0376 0.37630.7154
gov_exp.l6 -0.69600.9648-0.72140.4890
gdp.l6 0.07790.1580 0.49330.6336
taxes_prod_imp.l7 0.28120.8124 0.34610.7372
taxes_wealth.l7 -0.02061.7643-0.01170.9910
gov_exp.l7 -0.18021.0214-0.17650.8638
gdp.l7 -0.01450.1572-0.09200.9287
taxes_prod_imp.l8 -0.08570.8310-0.10310.9202
taxes_wealth.l8 0.25771.6168 0.15940.8769
gov_exp.l8 0.14451.0512 0.13750.8937
gdp.l8 -0.03610.1775-0.20360.8432
taxes_prod_imp.l9 -0.06090.8197-0.07430.9424
taxes_wealth.l9 0.59941.5336 0.39090.7050
gov_exp.l9 0.49780.9998 0.49790.6305
gdp.l9 -0.09050.1876-0.48230.6411
taxes_prod_imp.l10-0.30290.7512-0.40320.6962
taxes_wealth.l10 0.48651.3761 0.35350.7318
gov_exp.l10 0.19560.8902 0.21970.8310
gdp.l10 0.01440.1848 0.07760.9398
taxes_prod_imp.l11 0.04190.7895 0.05310.9588
taxes_wealth.l11 0.61601.0577 0.58240.5746
gov_exp.l11 0.19260.7199 0.26760.7951
gdp.l11 -0.03540.1616-0.21940.8312
taxes_prod_imp.l12 0.29390.7805 0.37660.7152
taxes_wealth.l12 0.34400.5459 0.63010.5443
gov_exp.l12 0.09940.4661 0.21330.8358
gdp.l12 -0.02650.1298-0.20390.8430
const 0.04801.3858 0.03460.9731
$gdp
A data.frame: 49 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 -0.11400.4304-0.26480.7971
taxes_wealth.l1 0.14880.4972 0.29930.7715
gov_exp.l1 -0.28880.2758-1.04740.3222
gdp.l1 0.65650.2822 2.32680.0450
taxes_prod_imp.l2 -0.38280.4880-0.78440.4529
taxes_wealth.l2 0.79941.0505 0.76100.4661
gov_exp.l2 -0.28170.5049-0.55790.5905
gdp.l2 0.10770.3730 0.28860.7794
taxes_prod_imp.l3 0.50560.5788 0.87350.4051
taxes_wealth.l3 0.74411.5212 0.48920.6364
gov_exp.l3 -0.37950.6595-0.57540.5791
gdp.l3 -0.13060.2487-0.52500.6123
taxes_prod_imp.l4 0.37240.6052 0.61530.5536
taxes_wealth.l4 0.44881.8378 0.24420.8125
gov_exp.l4 -0.46660.7234-0.64500.5350
gdp.l4 0.01180.1525 0.07750.9399
taxes_prod_imp.l5 -0.24800.6333-0.39170.7044
taxes_wealth.l5 0.41011.8124 0.22630.8261
gov_exp.l5 -0.01440.7576-0.01890.9853
gdp.l5 -0.04430.1244-0.35660.7296
taxes_prod_imp.l6 -0.07160.6034-0.11860.9082
taxes_wealth.l6 0.30731.5944 0.19270.8514
gov_exp.l6 0.11700.7549 0.15490.8803
gdp.l6 -0.00660.1236-0.05350.9585
taxes_prod_imp.l7 -0.38210.6357-0.60110.5626
taxes_wealth.l7 0.44961.3806 0.32570.7521
gov_exp.l7 0.15640.7992 0.19570.8492
gdp.l7 -0.02900.1230-0.23550.8191
taxes_prod_imp.l8 -0.04910.6502-0.07560.9414
taxes_wealth.l8 0.52901.2651 0.41810.6856
gov_exp.l8 -0.24580.8225-0.29880.7719
gdp.l8 -0.03160.1389-0.22760.8250
taxes_prod_imp.l9 0.10500.6414 0.16370.8736
taxes_wealth.l9 0.56171.2000 0.46810.6509
gov_exp.l9 -0.10400.7824-0.13290.8972
gdp.l9 0.07060.1468 0.48090.6421
taxes_prod_imp.l10 0.38820.5878 0.66040.5255
taxes_wealth.l10 1.11541.0768 1.03590.3273
gov_exp.l10 0.22520.6965 0.32330.7539
gdp.l10 -0.08960.1446-0.61960.5509
taxes_prod_imp.l11 0.25020.6178 0.40500.6950
taxes_wealth.l11 0.97040.8276 1.17260.2711
gov_exp.l11 -0.16630.5633-0.29520.7745
gdp.l11 -0.03200.1264-0.25280.8061
taxes_prod_imp.l12-0.31020.6107-0.50790.6237
taxes_wealth.l12 0.50050.4272 1.17170.2714
gov_exp.l12 -0.26670.3647-0.73130.4832
gdp.l12 0.05120.1015 0.50370.6266
const -0.06591.0844-0.06080.9529
In [16]:
lapply(summary(VAR_mdl.2)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 25 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.43900.2006 2.18860.0347
taxes_wealth.l1 0.10210.1654 0.61750.5405
gov_exp.l1 -0.00930.1187-0.07810.9382
gdp.l1 0.07050.0480 1.46890.1499
taxes_prod_imp.l2 0.26880.2243 1.19810.2381
taxes_wealth.l2 0.27600.2913 0.94760.3492
gov_exp.l2 0.00270.1958 0.01400.9889
gdp.l2 0.02710.0506 0.53550.5954
taxes_prod_imp.l3 0.03300.2236 0.14750.8835
taxes_wealth.l3 0.00450.3482 0.01280.9899
gov_exp.l3 -0.13330.2279-0.58470.5621
gdp.l3 0.02550.0520 0.48980.6270
taxes_prod_imp.l4 0.37680.2184 1.72500.0924
taxes_wealth.l4 0.05970.3398 0.17570.8615
gov_exp.l4 -0.25450.2011-1.26550.2132
gdp.l4 -0.04770.0525-0.90870.3691
taxes_prod_imp.l5-0.48970.2085-2.34870.0240
taxes_wealth.l5 -0.01450.2877-0.05030.9602
gov_exp.l5 -0.19950.1528-1.30570.1993
gdp.l5 0.01510.0476 0.31700.7529
taxes_prod_imp.l6-0.04500.2214-0.20300.8402
taxes_wealth.l6 -0.24970.1600-1.56070.1267
gov_exp.l6 -0.14060.1021-1.37670.1765
gdp.l6 0.06360.0411 1.54700.1299
const 0.49330.1812 2.72220.0096
$taxes_wealth
A data.frame: 25 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.15030.1852 -0.81150.4220
taxes_wealth.l1 -1.52930.1527-10.01340.0000
gov_exp.l1 0.08790.1096 0.80230.4273
gdp.l1 0.00440.0443 0.09910.9216
taxes_prod_imp.l2-0.30970.2071 -1.49510.1429
taxes_wealth.l2 -1.56780.2689 -5.82950.0000
gov_exp.l2 0.28700.1808 1.58760.1204
gdp.l2 0.05070.0468 1.08450.2848
taxes_prod_imp.l3-0.32940.2064 -1.59530.1187
taxes_wealth.l3 -1.66730.3215 -5.18580.0000
gov_exp.l3 0.14820.2104 0.70420.4855
gdp.l3 0.09060.0480 1.88830.0664
taxes_prod_imp.l4 0.04530.2017 0.22470.8234
taxes_wealth.l4 -1.31370.3138 -4.18670.0002
gov_exp.l4 0.02820.1857 0.15210.8799
gdp.l4 0.03880.0485 0.80040.4283
taxes_prod_imp.l5 0.15460.1925 0.80310.4268
taxes_wealth.l5 -0.90410.2657 -3.40300.0016
gov_exp.l5 -0.04850.1411 -0.34390.7328
gdp.l5 -0.00540.0439 -0.12260.9031
taxes_prod_imp.l6 0.38580.2044 1.88720.0666
taxes_wealth.l6 -0.55040.1477 -3.72590.0006
gov_exp.l6 0.04350.0943 0.46190.6467
gdp.l6 -0.00490.0380 -0.12830.8985
const 0.24060.1673 1.43810.1584
$gov_exp
A data.frame: 25 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.50520.2843-1.77690.0834
taxes_wealth.l1 -0.15160.2345-0.64650.5217
gov_exp.l1 -1.55440.1682-9.23900.0000
gdp.l1 0.15670.0681 2.30270.0267
taxes_prod_imp.l2 0.42850.3180 1.34760.1856
taxes_wealth.l2 0.10530.4129 0.25510.8000
gov_exp.l2 -1.74280.2776-6.27910.0000
gdp.l2 0.07900.0718 1.09990.2781
taxes_prod_imp.l3 0.54950.3169 1.73370.0909
taxes_wealth.l3 0.32920.4936 0.66710.5086
gov_exp.l3 -1.42720.3231-4.41770.0001
gdp.l3 -0.01140.0737-0.15480.8778
taxes_prod_imp.l4 0.13450.3096 0.43440.6664
taxes_wealth.l4 0.76350.4817 1.58510.1210
gov_exp.l4 -1.02320.2851-3.58940.0009
gdp.l4 -0.07350.0745-0.98710.3297
taxes_prod_imp.l5-0.56260.2956-1.90350.0644
taxes_wealth.l5 0.89680.4078 2.19900.0339
gov_exp.l5 -0.61440.2166-2.83700.0072
gdp.l5 0.02880.0674 0.42690.6718
taxes_prod_imp.l6-0.39490.3138-1.25840.2157
taxes_wealth.l6 0.30560.2268 1.34770.1855
gov_exp.l6 -0.42510.1447-2.93680.0055
gdp.l6 0.09170.0583 1.57320.1238
const 0.41420.2569 1.61260.1149
$gdp
A data.frame: 25 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.36120.7671 0.47080.6404
taxes_wealth.l1 0.20960.6325 0.33130.7422
gov_exp.l1 0.01740.4539 0.03820.9697
gdp.l1 -0.15750.1836-0.85770.3963
taxes_prod_imp.l2-0.41790.8578-0.48720.6288
taxes_wealth.l2 0.99161.1139 0.89020.3788
gov_exp.l2 -0.10980.7488-0.14660.8842
gdp.l2 -0.15870.1937-0.81930.4176
taxes_prod_imp.l3-1.00410.8550-1.17440.2474
taxes_wealth.l3 0.66311.3315 0.49800.6213
gov_exp.l3 -0.20190.8716-0.23170.8180
gdp.l3 0.16080.1987 0.80910.4234
taxes_prod_imp.l4 0.55330.8354 0.66240.5116
taxes_wealth.l4 0.43391.2995 0.33390.7403
gov_exp.l4 -1.17270.7690-1.52490.1354
gdp.l4 -0.01550.2009-0.07690.9391
taxes_prod_imp.l5-0.84640.7974-1.06150.2950
taxes_wealth.l5 -0.12531.1003-0.11390.9099
gov_exp.l5 -0.87270.5843-1.49360.1433
gdp.l5 0.13720.1819 0.75400.4554
taxes_prod_imp.l6 0.46040.8467 0.54380.5897
taxes_wealth.l6 -0.46890.6118-0.76630.4481
gov_exp.l6 -0.79270.3905-2.03000.0492
gdp.l6 0.13120.1573 0.83420.4092
const 1.07210.6930 1.54710.1299
In [17]:
lapply(summary(VAR_mdl.3)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 17 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.33780.1800 1.87660.0665
taxes_wealth.l1 -0.02320.1417-0.16370.8707
gov_exp.l1 0.02640.0947 0.27930.7812
gdp.l1 0.08190.0458 1.78740.0801
taxes_prod_imp.l2 0.13600.2164 0.62860.5325
taxes_wealth.l2 0.04190.2092 0.20020.8421
gov_exp.l2 0.04110.1274 0.32280.7482
gdp.l2 0.07440.0492 1.51360.1365
taxes_prod_imp.l3-0.00670.1920-0.03470.9725
taxes_wealth.l3 -0.09660.2078-0.46480.6441
gov_exp.l3 -0.02710.1154-0.23480.8154
gdp.l3 0.08100.0473 1.71080.0934
taxes_prod_imp.l4 0.22960.1858 1.23570.2225
taxes_wealth.l4 0.00740.1359 0.05420.9570
gov_exp.l4 -0.05550.0758-0.73250.4673
gdp.l4 0.01110.0379 0.29170.7717
const 0.35830.1595 2.24580.0293
$taxes_wealth
A data.frame: 17 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.30230.1802-1.67720.0999
taxes_wealth.l1 -1.34830.1419-9.50000.0000
gov_exp.l1 -0.02040.0948-0.21530.8304
gdp.l1 0.00520.0459 0.11380.9099
taxes_prod_imp.l2-0.15700.2166-0.72480.4720
taxes_wealth.l2 -1.17060.2095-5.58770.0000
gov_exp.l2 0.16880.1275 1.32340.1918
gdp.l2 0.01970.0492 0.40010.6908
taxes_prod_imp.l3-0.18060.1923-0.93900.3523
taxes_wealth.l3 -0.90900.2081-4.36810.0001
gov_exp.l3 0.16950.1156 1.46600.1490
gdp.l3 0.05960.0474 1.25870.2141
taxes_prod_imp.l4 0.38290.1861 2.05760.0450
taxes_wealth.l4 -0.38700.1361-2.84420.0065
gov_exp.l4 0.12330.0759 1.62370.1108
gdp.l4 -0.06100.0380-1.60740.1144
const 0.30330.1598 1.89850.0635
$gov_exp
A data.frame: 17 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.65800.2725-2.41450.0195
taxes_wealth.l1 -0.31660.2146-1.47510.1466
gov_exp.l1 -1.17480.1434-8.19490.0000
gdp.l1 0.20410.0693 2.94320.0050
taxes_prod_imp.l2 0.22390.3276 0.68340.4976
taxes_wealth.l2 -0.25340.3167-0.79990.4276
gov_exp.l2 -1.04710.1928-5.43000.0000
gdp.l2 0.16580.0744 2.22760.0305
taxes_prod_imp.l3 0.53460.2907 1.83880.0720
taxes_wealth.l3 -0.28600.3146-0.90900.3678
gov_exp.l3 -0.68010.1748-3.89140.0003
gdp.l3 0.01600.0716 0.22290.8246
taxes_prod_imp.l4-0.23120.2814-0.82170.4152
taxes_wealth.l4 -0.13400.2057-0.65120.5180
gov_exp.l4 -0.36850.1148-3.20980.0023
gdp.l4 0.03420.0574 0.59590.5540
const 0.15660.2415 0.64820.5199
$gdp
A data.frame: 17 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.16150.6567 0.24590.8068
taxes_wealth.l1 0.43260.5171 0.83650.4069
gov_exp.l1 -0.07530.3455-0.21800.8283
gdp.l1 -0.14840.1671-0.88820.3788
taxes_prod_imp.l2-0.18580.7894-0.23540.8149
taxes_wealth.l2 0.88570.7633 1.16050.2515
gov_exp.l2 -0.21770.4647-0.46850.6415
gdp.l2 -0.07000.1794-0.39030.6980
taxes_prod_imp.l3-1.05160.7006-1.50100.1398
taxes_wealth.l3 0.46740.7582 0.61650.5404
gov_exp.l3 -0.13190.4212-0.31320.7554
gdp.l3 0.15850.1726 0.91790.3631
taxes_prod_imp.l4 0.10740.6780 0.15850.8748
taxes_wealth.l4 0.28260.4958 0.57010.5712
gov_exp.l4 -0.44780.2766-1.61890.1119
gdp.l4 0.02550.1383 0.18470.8543
const 1.15350.5821 1.98170.0531
In [18]:
lapply(summary(VAR_mdl.4)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 13 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.40870.1692 2.41500.0191
taxes_wealth.l1 -0.08600.1065-0.80720.4231
gov_exp.l1 0.03000.0788 0.38030.7052
gdp.l1 0.06090.0428 1.42250.1606
taxes_prod_imp.l2 0.09000.1855 0.48490.6297
taxes_wealth.l2 -0.01840.1447-0.12730.8992
gov_exp.l2 0.09930.0904 1.09910.2766
gdp.l2 0.06190.0415 1.48990.1421
taxes_prod_imp.l3 0.13300.1626 0.81780.4170
taxes_wealth.l3 -0.15360.1004-1.53000.1318
gov_exp.l3 0.03580.0693 0.51660.6076
gdp.l3 0.04510.0365 1.23560.2220
const 0.43490.1372 3.16940.0025
$taxes_wealth
A data.frame: 13 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.22940.1955-1.17350.2457
taxes_wealth.l1 -1.11350.1231-9.04830.0000
gov_exp.l1 0.04940.0910 0.54320.5893
gdp.l1 -0.02350.0495-0.47590.6360
taxes_prod_imp.l2-0.01880.2143-0.08760.9305
taxes_wealth.l2 -0.70480.1671-4.21720.0001
gov_exp.l2 0.23470.1044 2.24760.0287
gdp.l2 -0.05510.0480-1.14760.2562
taxes_prod_imp.l3-0.03400.1879-0.18080.8572
taxes_wealth.l3 -0.43800.1160-3.77670.0004
gov_exp.l3 0.13740.0801 1.71520.0920
gdp.l3 0.02220.0422 0.52620.6009
const 0.33430.1585 2.10890.0396
$gov_exp
A data.frame: 13 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.76860.2804-2.74140.0083
taxes_wealth.l1 -0.30290.1765-1.71640.0918
gov_exp.l1 -1.03890.1305-7.95820.0000
gdp.l1 0.21020.0710 2.96190.0045
taxes_prod_imp.l2 0.04920.3074 0.16020.8733
taxes_wealth.l2 -0.24420.2397-1.01880.3129
gov_exp.l2 -0.71280.1498-4.75970.0000
gdp.l2 0.21640.0688 3.14360.0027
taxes_prod_imp.l3 0.67190.2695 2.49330.0158
taxes_wealth.l3 -0.10430.1663-0.62730.5331
gov_exp.l3 -0.27520.1149-2.39480.0201
gdp.l3 0.01620.0605 0.26690.7905
const 0.05760.2273 0.25340.8009
$gdp
A data.frame: 13 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.09380.6218 0.15080.8807
taxes_wealth.l1 0.15960.3914 0.40770.6851
gov_exp.l1 0.02780.2895 0.09600.9239
gdp.l1 -0.16250.1574-1.03260.3064
taxes_prod_imp.l2-0.36610.6817-0.53710.5934
taxes_wealth.l2 0.40630.5315 0.76440.4479
gov_exp.l2 0.09060.3321 0.27270.7861
gdp.l2 -0.02550.1526-0.16720.8678
taxes_prod_imp.l3-0.80760.5976-1.35130.1822
taxes_wealth.l3 0.05400.3688 0.14640.8841
gov_exp.l3 0.24560.2548 0.96400.3393
gdp.l3 0.10540.1342 0.78500.4359
const 1.28430.5041 2.54770.0137
In [19]:
lapply(summary(VAR_mdl.5)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 9 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.47780.1451 3.29290.0017
taxes_wealth.l1 -0.02840.0945-0.30010.7651
gov_exp.l1 0.05540.0580 0.95430.3438
gdp.l1 0.03060.0383 0.79920.4274
taxes_prod_imp.l2 0.17750.1480 1.19900.2353
taxes_wealth.l2 0.10060.0866 1.16130.2502
gov_exp.l2 0.12210.0490 2.48990.0156
gdp.l2 0.03700.0354 1.04390.3008
const 0.40730.1282 3.17740.0024
$taxes_wealth
A data.frame: 9 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.13920.1976-0.70430.4840
taxes_wealth.l1 -0.93060.1287-7.23320.0000
gov_exp.l1 0.03050.0790 0.38660.7005
gdp.l1 -0.08770.0522-1.68090.0981
taxes_prod_imp.l2-0.04060.2016-0.20120.8412
taxes_wealth.l2 -0.26900.1180-2.27970.0263
gov_exp.l2 0.22220.0668 3.32690.0015
gdp.l2 -0.06030.0483-1.24890.2166
const 0.21470.1746 1.22990.2236
$gov_exp
A data.frame: 9 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.75340.2595-2.90310.0052
taxes_wealth.l1 -0.40430.1690-2.39310.0199
gov_exp.l1 -0.81680.1038-7.87090.0000
gdp.l1 0.17740.0685 2.58970.0121
taxes_prod_imp.l2 0.62850.2647 2.37380.0209
taxes_wealth.l2 -0.34440.1549-2.22270.0301
gov_exp.l2 -0.53090.0877-6.05270.0000
gdp.l2 0.10890.0634 1.71810.0910
const 0.15270.2292 0.66590.5081
$gdp
A data.frame: 9 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1 0.22940.5211 0.44020.6614
taxes_wealth.l1 0.16010.3392 0.47200.6387
gov_exp.l1 -0.19550.2084-0.93810.3520
gdp.l1 -0.15470.1376-1.12460.2653
taxes_prod_imp.l2-1.03340.5316-1.94410.0567
taxes_wealth.l2 0.45010.3111 1.44670.1533
gov_exp.l2 -0.10370.1761-0.58890.5582
gdp.l2 0.06980.1273 0.54840.5855
const 0.95810.4603 2.08140.0417

Išbandžius visų metrikų pasiūlytus 'lag' parametro kiekius, gaunami tokie rezultatai (stat. reikšm. kint. kiekio atžvilgiu): Lag = 12: itin daug kintamųjų ir praktiškai visi stat. nereikšm. Pasirinkimas atmetamas.

Lag = 6: taxes_prod_imp = 3, taxes_wealth = 6, gov_exp = 8, gdp = 1

Lag = 4: taxes_prod_imp = 1, taxes_wealth = 6, gov_exp = 7, gdp = 1

Lag = 3: taxes_prod_imp = 2, taxes_wealth = 5, gov_exp = 7, gdp = 1

Lag = 2: taxes_prod_imp = 3, taxes_wealth = 3, gov_exp = 8, gdp = 1

Kai lag sk. didžiausias, stat. nereikšm. kintamųjų gaunasi itin daug. Turint omenyje, jog viso turima 70 stebinių, tiek daug parametrų gali sukelti peroptimizavimą (overparametrized/overfitted). Su mažesniais 'lag' skaičiais kintamųjų parametrų kiekis yra daugiau mažiau panašus. Panašu, jog optimaliausias variantas būtų, kai lag = 3.

4. Atlikite Grangerio priežastingumo analizę (papildomas šaltinis su pavyzdžiu: [Ch. 11.4.1, Example 68]) ir kiekvienam rodikliui nustatykite, kurie rodikliai yra Grangerio priežastis. Uždėkite VAR modelio statistiškai nereikšmingiems koeficientams nulinius paribojimus. (Pastaba: tolimesnėse užduotyse nebūtina naudoti VAR modelio su tiesiniais apribojimais.)

In [20]:
restrictions <- matrix(c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
                         0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1,
                         1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0,
                         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1),
                       nrow = 4, ncol = 13, byrow = TRUE)

VAR_mdl_restricted.4 <- restrict(VAR_mdl.4, method = "manual", resmat = restrictions)
lapply(summary(VAR_mdl_restricted.4)$varresult, function(x){
  tibble::rownames_to_column(round(coef(x), 4) %>% as.data.frame(), "Coefficient")
})
$taxes_prod_imp
A data.frame: 2 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l10.54450.10405.23460
const 0.53940.12344.37170
$taxes_wealth
A data.frame: 5 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_wealth.l1-1.04950.0964-10.88210.0000
taxes_wealth.l2-0.72260.1348 -5.35940.0000
gov_exp.l2 0.13740.0570 2.41110.0189
taxes_wealth.l3-0.50540.1039 -4.86260.0000
const -0.00020.0074 -0.03160.9749
$gov_exp
A data.frame: 7 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
taxes_prod_imp.l1-0.80020.2025 -3.95260.0002
gov_exp.l1 -1.04060.0956-10.88810.0000
gdp.l1 0.20510.0670 3.06230.0033
gov_exp.l2 -0.69930.1125 -6.21570.0000
gdp.l2 0.25830.0611 4.22490.0001
taxes_prod_imp.l3 0.80060.2020 3.96390.0002
gov_exp.l3 -0.33890.0930 -3.64530.0006
$gdp
A data.frame: 1 × 5
CoefficientEstimateStd. Errort valuePr(>|t|)
<chr><dbl><dbl><dbl><dbl>
const0.00290.02330.12670.8995

H0: kintamasis nėra kitų kintamųjų Granger priežąstis
H1: kintamasis yra kitų kintamųjų Granger priežąstis

In [21]:
causality(VAR_mdl_restricted.4, cause = "taxes_prod_imp", vcov. = vcovHC(VAR_mdl_restricted.4))

# Kadangi p-value < 0.05, tai H0 atmetamas. Teigiama, jog 'taxes_prod_imp' yra kitų kintamųjų Granger priežąstis
    
causality(VAR_mdl_restricted.4, cause = "taxes_wealth", vcov. = vcovHC(VAR_mdl_restricted.4))

# Kadangi p-value < 0.05, tai H0 atmetamas. Teigiama, jog 'taxes_wealth' yra kitų kintamųjų Granger priežąstis

causality(VAR_mdl_restricted.4, cause = "gov_exp", vcov. = vcovHC(VAR_mdl_restricted.4))

# Kadangi p-value < 0.05, tai H0 atmetamas. Teigiama, jog 'gov_exp' yra kitų kintamųjų Granger priežąstis

causality(VAR_mdl_restricted.4, cause = "gdp", vcov. = vcovHC(VAR_mdl_restricted.4))

# Kadangi p-value < 0.05, tai H0 atmetamas. Teigiama, jog 'gdp' yra kitų kintamųjų Granger priežąstis
$Granger

	Granger causality H0: taxes_prod_imp do not Granger-cause taxes_wealth
	gov_exp gdp

data:  VAR object VAR_mdl_restricted.4
F-Test = 6.786, df1 = 9, df2 = 216, p-value = 1.429e-08


$Instant

	H0: No instantaneous causality between: taxes_prod_imp and taxes_wealth
	gov_exp gdp

data:  VAR object VAR_mdl_restricted.4
Chi-squared = 11.452, df = 3, p-value = 0.009519

$Granger

	Granger causality H0: taxes_wealth do not Granger-cause taxes_prod_imp
	gov_exp gdp

data:  VAR object VAR_mdl_restricted.4
F-Test = 7.014, df1 = 9, df2 = 216, p-value = 7.02e-09


$Instant

	H0: No instantaneous causality between: taxes_wealth and taxes_prod_imp
	gov_exp gdp

data:  VAR object VAR_mdl_restricted.4
Chi-squared = 6.1574, df = 3, p-value = 0.1042

$Granger

	Granger causality H0: gov_exp do not Granger-cause taxes_prod_imp
	taxes_wealth gdp

data:  VAR object VAR_mdl_restricted.4
F-Test = 6.8373, df1 = 9, df2 = 216, p-value = 1.218e-08


$Instant

	H0: No instantaneous causality between: gov_exp and taxes_prod_imp
	taxes_wealth gdp

data:  VAR object VAR_mdl_restricted.4
Chi-squared = 6.5618, df = 3, p-value = 0.08726

$Granger

	Granger causality H0: gdp do not Granger-cause taxes_prod_imp
	taxes_wealth gov_exp

data:  VAR object VAR_mdl_restricted.4
F-Test = 7.3511, df1 = 9, df2 = 216, p-value = 2.466e-09


$Instant

	H0: No instantaneous causality between: gdp and taxes_prod_imp
	taxes_wealth gov_exp

data:  VAR object VAR_mdl_restricted.4
Chi-squared = 9.7078, df = 3, p-value = 0.02122

5. Atlikite įvertinto VAR modelio liekanų analizę. Ką šios analizės rezultatai pasako apie modelio adekvatumą?

Autokoreliacijos testas (serial autocorrelation)

H0: liekanos nėra autokoreliuotos
H1: liekanos yra autokoreliuotos

In [22]:
serial.test(VAR_mdl_restricted.4, lags.pt = 4, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 100.65, df = 16, p-value = 2.609e-14

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 100.65, df = 16, p-value = 2.609e-14

In [23]:
serial.test(VAR_mdl_restricted.4, lags.pt = 6, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 128.18, df = 48, p-value = 3.144e-09

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 128.18, df = 48, p-value = 3.144e-09

In [24]:
serial.test(VAR_mdl_restricted.4, lags.pt = 12, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 176.78, df = 144, p-value = 0.03287

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 176.78, df = 144, p-value = 0.03287

In [25]:
serial.test(VAR_mdl_restricted.4, lags.pt = 13, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 183.34, df = 160, p-value = 0.09978

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl_restricted.4
Chi-squared = 183.34, df = 160, p-value = 0.09978

Atlikus autokoreliacijos testą VAR modeliui su tiesiniais apribojimais, autokoreliacija egzistuoja iki pat 13-to lag'o. T. y., tik nuo 13-to lag'o p-value > 0.05. Kas indikuoja, jog autokoreliacijos nėra (H0 neatmetamas). Neatrodo, jog šį VAR modelį su tiesiniais apribojimais būtų adekvatu naudoti toliau.

In [26]:
serial.test(VAR_mdl.4, lags.pt = 5, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 48.113, df = 32, p-value = 0.03358

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 48.113, df = 32, p-value = 0.03358

In [27]:
serial.test(VAR_mdl.4, lags.pt = 6, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 59.847, df = 48, p-value = 0.1173

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 59.847, df = 48, p-value = 0.1173

In [28]:
serial.test(VAR_mdl.4, lags.pt = 13, type = "PT.asymptotic")
	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 118.07, df = 160, p-value = 0.9946

$serial

	Portmanteau Test (asymptotic)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 118.07, df = 160, p-value = 0.9946

Atlikus autokoreliacijos testą tiesiškai neapribotam VAR modeliui, autokoreliacija liekanose dingsta ties 6-tu lag'u. Panašu, jog tai indikuoja labiau adekvatų VAR modelį turimiems duomenims. Toliau bus naudojamas VAR modelis be tiesinių apribojimų ('VAR_mdl.4').

In [29]:
options(repr.plot.width = 15, repr.plot.height = 8, repr.plot.res = 500)
In [30]:
mdl_serial_test <- serial.test(VAR_mdl.4, lags.pt = 6, type = "PT.asymptotic")
residual <- residuals(VAR_mdl.4)
In [31]:
plot(mdl_serial_test, name = "taxes_prod_imp")
No description has been provided for this image
In [32]:
hist(residual[, "taxes_prod_imp"], probability = TRUE, main = "Histogram and EDF") # papildomai nubrėžiama histograma, kadangi grafikų panelėje ji nelabai matosi
lines(density(residual[, "taxes_prod_imp"]), col = "blue")
No description has been provided for this image
In [33]:
plot(mdl_serial_test, name = "taxes_wealth")
No description has been provided for this image
In [34]:
hist(residual[, "taxes_wealth"], probability = TRUE, main = "Histogram and EDF")
lines(density(residual[, "taxes_prod_imp"]), col = "blue")
No description has been provided for this image
In [35]:
plot(mdl_serial_test, name = "gov_exp")
No description has been provided for this image
In [36]:
hist(residual[, "gov_exp"], probability = TRUE, main = "Histogram and EDF")
lines(density(residual[, "taxes_prod_imp"]), col = "blue")
No description has been provided for this image
In [37]:
plot(mdl_serial_test, name = "gdp")
No description has been provided for this image
In [38]:
hist(residual[, "gdp"], probability = TRUE, main = "Histogram and EDF")
lines(density(residual[, "taxes_prod_imp"]), col = "blue")
No description has been provided for this image

Pastebima, jog visų kintamųjų ACF bei PACF grafikuose esančios vertikalios linijos ties tam tikru kiekiu lag'ų neišlenda aukščiau ar žemiau pasikliovimo intervalo (mėlyna punktyrinė linija). Tai reiškia, jog nėra jokios žymios autokoreliacijos. Kitaip tariant modelio kintamųjų liekanos yra baltasis triukšmas (angl. white noise).

Ta pati tendencija liečia ir squared ACF/PACF grafikus. Esančios vertikalios linijos neišlinda už pasikliovimo intervalo ribų (tik vienetiniai atvejai kur viena ar dvi linijos yra šiek tiek virš numatytos ribos).

Taip pat panašu, jog kintamųjų "taxes_prod_imp", "taxes_wealth" bei "gov_exp" liekanų histogramos tenkina normalųjį skirstinį (kintamojo "gdp" atveju tas nelabai matosi). Tiesa, "taxes_prod_imp" histograma yra pasislinkusi į kairę (angl. left skewed), "taxes_wealth" pasislinkusi į dešinę (angl. right skewed), o "gov_exp" iš visų kintamųjų liekanų yra pati simetriškiausia ir labiausiai atitinkanti normalųjį pasiskirstymą. Panašu, jog įvertintas modelis yra daugiau mažiau adekvatus pagal kintamųjų liekanų histogramas.

Homoskedastiškumo testas

H0: liekanos yra homoskedastiškos
H1: liekanos nėra homoskedastiškos

In [39]:
print(arch.test(VAR_mdl.4, lags.multi = 6, multivariate.only = TRUE
	ARCH (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 610, df = 600, p-value = 0.3797

$arch.mul

	ARCH (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 610, df = 600, p-value = 0.3797

Kadangi p-value > 0.05, tai H0 neatmetamas. Teigiama, jog liekanos yra homoskedastiškos. Tai yra viena iš indikacijų, jog įvertintas modelis yra adekvatus.

Liekanų normalumo testas

H0: liekanos tenkina normalųjį skirstinį
H1: liekanos netenkina normalaus skirstinio

In [40]:
print(normality.test(VAR_mdl.4, multivariate.only = TRUE))
$JB

	JB-Test (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 36.823, df = 8, p-value = 1.241e-05


$Skewness

	Skewness only (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 5.9717, df = 4, p-value = 0.2013


$Kurtosis

	Kurtosis only (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 30.851, df = 4, p-value = 3.284e-06


$jb.mul
$jb.mul$JB

	JB-Test (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 36.823, df = 8, p-value = 1.241e-05


$jb.mul$Skewness

	Skewness only (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 5.9717, df = 4, p-value = 0.2013


$jb.mul$Kurtosis

	Kurtosis only (multivariate)

data:  Residuals of VAR object VAR_mdl.4
Chi-squared = 30.851, df = 4, p-value = 3.284e-06


Nors iš ankščiau aptartų grafikų buvo galima įžiūrėti, jog liekanos tenkina normalumo sąlygą, tačiau pagal testo rezultatus matoma, jog prie 'JB-Test (multivariate)' esantis p-value < 0.05, H0 atmetamas. Teigiama, jog liekanos netenkina normalumo sąlygos. Bendrasis liekanų normalumo testas ('JB-Test') rodo nenormalumą. Pagrindinė to priežastis yra eksceso koeficientas (angl. kurtosis). Pastarojo p-value < 0.05. Tuo tarpu asimterijos (angl. skewness) p-value > 0.05. Tai reikštų, jog liekanos turi "sunkesnes" / "lengvesnes" uodegas (angl. tail) nei, kad normaliojo skirstinio atveju.

Liekanų struktūrinio lūžio testas

H0: liekanose yra struktūrinis lūžis
H1: liekanose nėra struktūrinio lūžio

In [41]:
mdl_cumsum <- stability(VAR_mdl.4, type = "OLS-CUSUM")
plot(mdl_cumsum)
No description has been provided for this image

Kadangi nei vieno iš kintamųjų grafiko kreivė neišlenda už raudonos tiesės ribų, tai H0 atmetamas. Teigiama, jog liekanose nėra struktūrinio lūžio (t. y., koeficientai yra stabilūs per numatytą duomenų laiko tarpą).

Modelio adekvatumo vertinimas

Liekanų autokoreliacijos testas: liekanos nėra autokoreliuotos
Homoskedastiškumo testas: liekanos yra homoskedastiškos
Normalumo testas: liekanos netenkina normalumo sąlygos
Liekanų struktūrinio lūžio testas: liekanose nėra struktūrinio lūžio

Kadangi įvertintas VAR modelis tenkino tris iš keturių testų, tai galima teigti, jog jis yra ganėtinai adekvatus. Didžiausias minusas yra, jog sudaryto modelio liekanos netenkina normalumo sąlygos. Kaip buvo pastebėta ankščiau, toks testo rezultatas buvo įtakotas eksceso koeficiento, kurio p-value < 0.05. Kita vertus, asimetrijos p-value > 0.05.

6. Atlikite įvertinto modelio IRF analizę, bei FEVD analizę - pasirinkite vieną rodiklį, iš kurio ateina impulsas (pvz. ortogonalus impulsas ateina iš iš valstybės išlaidų) ir pakomentuokite grafikų rezultatus.

In [63]:
# IRF (Impulso - Atsako) analizė (IRF: Impulse-Response Function)

set.seed(123)
for(i in c("taxes_prod_imp", "taxes_wealth", "gov_exp")){
  plot(irf(VAR_mdl.4, impulse = "gdp", response = i, n.ahead = 20, boot = TRUE))
}
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image

'taxes_prod_imp'

Laikotarpio pradžioje matomas teigiamas 'gdp' šokas, kuris indikuoja, jog padidėjus 'gdp, 'taxes_prod_imp' (valstybės pajamos iš mokesčių, taikomų produkcija ir importui) taip pat padidėja. Atsakas į šoką yra didžiausias apie 4-ąjį ketvirtį, vėliau jis gan ženkliai mažėja. Bėgant laikui tampa neaišku kaip impulsas iš 'gdp' įtakoja 'taxes_prod_imp'.

'taxes_wealth'

Laikotarpio pradžioje 'gdp' sukeltas šokas panašu, jog neigiamai įtakoja 'taxes_wealth', apie 4-tą ketvirtį matomas gana nemažas 'taxes_wealth' padidėjimas. Vėliau jis šokinėja gana agresyviai kol galiausiai bėgant laikui nublanksta ir nėra aišku kaip 'gdp' šokas toliau įtakoja 'taxes_wealth' reikšmes.

'gov_exp'

Laikotarpio pradžioje matomas gana ryškus padidėjimas 'gov_exp' kas atrodo gana logiška. Didesnis 'gdp', didesnės valstybės išlaidos ('gov_exp'). Panašu, jog atsakas didžiausias pirmaisiais periodais, o vėliau kaip ir ankstesniuose grafikuose jis nublanksta.

In [64]:
# FEVD analizė (Prognozės paklaidų dispersijos dekompozicija)
    
VAR_mdl.4_decomp <- fevd(VAR_mdl.4, n.ahead = 20)
plot(VAR_mdl.4_decomp)
No description has been provided for this image

taxes_prod_imp dispersija daugiausiai susideda iš nukrypimo nuo taxes_prod_imp. Kiti makrorodikliai panašu, jog įtakos daro itin mažai. Didžiausią įtaką daro gdp, kurio dalis vizualiai atrodo didžiausia.

taxes_wealth dispersija daugiausiai susideda iš nukrypimo nuo taxes_wealth, tačiau salyginai nemažą dalį (lyginant su likusiais rodikliais) sudaro nukrypimas nuo taxes_wealth_prod. Kas galėtų indikuoti, jog šie mokesčiai tarpusavyje susiję.

gov_exp dispersija daugiausiai susideda iš nukrypimo nuo gov_exp. Tuo tarpu nukrypimai nuo taxes_wealth ir taxes_prod_imp turi panašią įtaką. Tai yra logiška, kadangi pgr. valstybės pajamų šaltinis yra mokesčiai. Iš to seka kaip daug valstybė gali išleisti.

gdp dispersija daugiausiai susideda iš nukrypimo nuo gdp bei taxes_prod_imp. Kadangi antrasis rodiklis yra būtent taxes_prod_imp, tai galėtų indikuoti, jog šioje vietoje gaunami mokesčiai sudaro kur kas didesnę dalį bendrų pajamų, gaunamų iš mokesčių apskritai (lyginant taxes_prod_imp ir taxes_wealth).

III dalis: SVAR modelio specifikacija ir rezultatų analizė¶

7. Sudarykite SVAR modelį:

a. Koks SVAR modelis buvo sudarytas straipsnyje - A-modelis, B-modelis, ar AB-modelis?

Straipsnyje buvo sudarytas A-modelis. Diagonalės elementai yra vienetai, kas priklauso sudarinėjant standartinį SVAR modelį. Po diagonale esantys elementai žymi vienalaikius (angl. contemporaneous) vieno kintamojo efektus kitam kintamajam. Tuo tarpu nuliai matricoje žymi tokius kintamusuosius, kurie pastarojo efekto neturi.

b. Kiek nežinomųjų galime turėti, kad sistema SVAR modelyje būtų tiksliai identifikuota?

Viso nežinomųjų: $\frac{N(N + 1)}{2} = \frac{4(4 + 1)}{2} = \frac{4 \cdot 5}{2} = 10$, kur $N - kint. sk.$

Taigi, viso galima turėti 10 kintamųjų norint, jog sistema SVAR modelyje būtų tiksliai identifikuota.

c. Kokios straipsnyje įvardytos prielaidos, pagal kurias uždedami apribojimai?

Naudojama Cholesky dekompozicija (angl. Cholesky decomposition) ir kintamieji yra išdėstyti taip, jog pirmasis kintamasis ("Taxes on Income and wealth") neturi jokio vienalaikio efekto likusiems kintamųjų šokams (kurie yra žymimi "u"). Tokio tipo išdėstymą matricoje indikuoja pirmoje eilutėje esantys nuliai (išskyrus pirmąjį skaičių, kuris yra diagonalėje bei nekreipiant dėmesio į paskutinį skaičių, kuris yra įvertintas parametras). Tęsiant toliau, antrasis kintamasis ("Taxes on Production and imports") reaguoja tik į pirmąjį šoką ir nereaguoja į likusius (tą indikuoja nulis, esanatis 2-oje eil. 3-iame stulp.). Trečiasis kintamasis ("Primary expenditure") reaguoja į pirmus du šokus, tačiau ne į ketvirtąjį (tą indikuoja 3-ioje eil. 4-ame stulp. esantis nulis). Galiausiai, ketvirtasis kintamasis ("GDP") gali reaguoti į visus prieš tai buvusius šokus (tą indikuoja nenuliniai koeficientai 4-oje eil.).

d. Užrašykite šiuos apribojimus matriciniu pavidalu atitinkamoje SVAR modelio specifikacijoje ir įvertinkite šį modelį.

In [42]:
restrictions.SVAR <- matrix(c(1, 0, 0, 0,
                              NA, 1, 0, 0,
                              NA, NA, 1, 0,
                              NA, NA, NA, 1),
                            nrow = 4, ncol = 4, byrow = TRUE)

SVAR.mdl <- SVAR(VAR_mdl.4, Amat = restrictions.SVAR, max.iter = 10000)
In [43]:
print(SVAR.mdl)
SVAR Estimation Results:
======================== 


Estimated A matrix:
               taxes_prod_imp taxes_wealth gov_exp gdp
taxes_prod_imp         1.0000       0.0000  0.0000   0
taxes_wealth          -0.2974       1.0000  0.0000   0
gov_exp               -0.4211       0.5224  1.0000   0
gdp                   -2.1732       0.3375  0.1624   1
In [44]:
SVAR.mdl$LR$data.name
SVAR.mdl$LR$method
SVAR.mdl$LR$p.value
SVAR.mdl$LR$statistic
df_final[, 2:5]
'LR overidentification'
Chi^2: 0
Chi^2: 1374.99407124309
In [46]:
SVAR.mdl$A # įvertintų koef. matrica
A matrix: 4 × 4 of type dbl
taxes_prod_imptaxes_wealthgov_expgdp
taxes_prod_imp 1.00000000.00000000.00000000
taxes_wealth-0.29742501.00000000.00000000
gov_exp-0.42113360.52241671.00000000
gdp-2.17323050.33751590.16244191
In [47]:
SVAR.mdl$Ase # A paklaidų matrica
A matrix: 4 × 4 of type dbl
taxes_prod_imptaxes_wealthgov_expgdp
taxes_prod_imp0.00000000.00000000.00000000
taxes_wealth0.12216940.00000000.00000000
gov_exp0.12745860.12216940.00000000
gdp0.13745090.13783610.12216940

8. Ištirkite įvertintą SVAR modelį:

a. Kaip atrodo šio modelio impulso-atsako funkcijų grafikai, naudojant impulsą iš to pačio rodiklio kaip 8 užduotyje? Ar jie skiriasi nuo VAR modelio IRF grafikų?

In [60]:
for(i in c("taxes_prod_imp", "taxes_wealth", "gov_exp")){
  plot(irf(SVAR.mdl, impulse = "gdp", response = i, n.ahead = 20, boot = TRUE))
}
No description has been provided for this image
No description has been provided for this image
No description has been provided for this image
In [62]:
par(mfrow = c(2, 2), mar = c(2.2, 2.2, 1.5, 0.5))
for(i in c("taxes_prod_imp", "taxes_wealth", "gov_exp")){
  V_T <- irf(VAR_mdl.4, impulse = "gdp", response = i, n.ahead = 20, boot = TRUE)
  S_T <- irf(SVAR.mdl, impulse = "gdp", response = i, n.ahead = 20, boot = TRUE)
  V_T <- unlist(V_T$irf, use.names = FALSE)
  S_T <- unlist(S_T$irf, use.names = FALSE)
  #
  plot.ts(V_T, ylim = c(min(V_T, S_T), max(V_T, S_T)), 
          main = paste0("Ortogonalus impulsas iš GDP, atsakas ", i))
  lines(ts(S_T), col = "blue")
  abline(h = 0, lty = 2, col = "red")
  legend("right", legend = c("VAR", "SVAR"), lty = 1, col = c("black", "blue"), cex = 0.8)
}
Warning message in SVAR(x = varboot, Amat = restrictions.SVAR, max.iter = 10000):
"Convergence not achieved after 10000 iterations. Convergence value: 1.23539440677334e-07 ."
No description has been provided for this image

Lyginant SVAR ir VAR modelių IRF grafikus matomas itin didelis skirtumas. Naudojant tą patį impulsą, likusių makroekonominių rodiklių atsakai yra ženkliai didesni (tiek teigiami tiek neigiami). T. y., pasiekiamos aukštesnės reikšmės Y ašyje, tačiau pačios kreivės tendencija išlieka identiška: pikai ir žemumos yra identiškose vietose ir taip pat vienodai nublanksta bėgant laikui).

b. Remdamiesi straipsnyje nurodyta metodika, apskaičiuokite fiskalinius daugiklius. Kaip jūsų konkrečios šalies modelio fiskaliniai daugikliai skiriasi nuo straipnio 2 lentelės rezultatų?

In [57]:
irf_taxes_prod_imp <- irf(VAR_mdl.4, impulse = "taxes_prod_imp", response = "gdp", n.ahead = 4, boot = TRUE) # 'n.ahead = 4' - kadangi duomenys ketvirtiniai, tai 'irf' f-ja vertins šoką metams į priekį
irf_taxes_wealth <- irf(VAR_mdl.4, impulse = "taxes_wealth", response = "gdp", n.ahead = 4, boot = TRUE)
irf_gov_exp <- irf(VAR_mdl.4, impulse = "gov_exp", response = "gdp", n.ahead = 4, boot = TRUE) 

taxes_prod_imp_multiplier <- sum(irf_taxes_prod_imp$irf$taxes_prod_imp[ , "gdp"])
taxes_wealth_multiplier <- sum(irf_taxes_wealth$irf$taxes_wealth[ , "gdp"])
gov_exp_multiplier <- sum(irf_gov_exp$irf$gov_exp[ , "gdp"])

fiscal_multipliers <- c("taxes_prod_imp" = taxes_prod_imp_multiplier, "taxes_wealth" = taxes_wealth_multiplier,
                        "gov_exp" = gov_exp_multiplier)
fiscal_multipliers
taxes_prod_imp
-0.0333203373390602
taxes_wealth
0.00748890525247068
gov_exp
-0.0082628195028223

Lyginant įvertintus rodiklius su tais, kurie pateikti straipsnyje matomas itin didelis skirtumas. Šiuo atveju įvertinti rodikliai yra tik vienos šalies - Italijos. Tuo tarpu straipsnyje autoriai naudoja Eurozonos šalių makroekonominius rodiklius nuo EMU (European Monetary Union) sukūrimo. Turint omenyje, jog duomenys sudaryti iš keliolikos šalių, tai galbūt todėl daugikliai taip žymiai skiriasi. Kiekvienos iš šalių makroekonominiai rodikliai gali skirtis itin drastiškai, kas gali įtakoti didesnius fiskalinius daugiklius.